home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue63 / Docking / DockedControls9U.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-09-19  |  5.0 KB  |  165 lines
  1. unit DockedControls9U;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ComCtrls, ToolWin, StdCtrls, ImgList, ExtCtrls, ActnList, Menus;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ImageList1: TImageList;
  12.     Label1: TLabel;
  13.     MainMenu1: TMainMenu;
  14.     ActionList1: TActionList;
  15.     actToggleToolbar: TAction;
  16.     Environment1: TMenuItem;
  17.     Toolbarvisible1: TMenuItem;
  18.     btnToggleFloat: TButton;
  19.     ToolBar1: TToolBar;
  20.     ToolButton6: TToolButton;
  21.     ToolButton7: TToolButton;
  22.     ToolButton8: TToolButton;
  23.     ToolButton9: TToolButton;
  24.     ToolButton10: TToolButton;
  25.     TopDockPanel: TPanel;
  26.     RightDockPanel: TPanel;
  27.     LeftDockPanel: TPanel;
  28.     BottomDockPanel: TPanel;
  29.     PageControl1: TPageControl;
  30.     TabSheet1: TTabSheet;
  31.     Label2: TLabel;
  32.     Image1: TImage;
  33.     procedure FormCreate(Sender: TObject);
  34.     procedure actToggleToolbarExecute(Sender: TObject);
  35.     procedure actToggleToolbarUpdate(Sender: TObject);
  36.     procedure btnToggleFloatClick(Sender: TObject);
  37.     procedure DockPanelGetSiteInfo(Sender: TObject; DockClient: TControl;
  38.       var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
  39.     procedure DockPanelDockOver(Sender: TObject;
  40.       Source: TDragDockObject; X, Y: Integer; State: TDragState;
  41.       var Accept: Boolean);
  42.     procedure DockPanelDockDrop(Sender: TObject;
  43.       Source: TDragDockObject; X, Y: Integer);
  44.     procedure PageControl1DockDrop(Sender: TObject;
  45.       Source: TDragDockObject; X, Y: Integer);
  46.     procedure PageControl1GetSiteInfo(Sender: TObject;
  47.       DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  48.       var CanDock: Boolean);
  49.   private
  50.     { Private declarations }
  51.   public
  52.     { Public declarations }
  53.   end;
  54.  
  55. var
  56.   Form1: TForm1;
  57.  
  58. implementation
  59.  
  60. {$R *.DFM}
  61.  
  62. procedure TForm1.FormCreate(Sender: TObject);
  63. begin
  64.   Mouse.DragImmediate := False;
  65.   Image1.ManualDock(PageControl1);
  66.   ToolBar1.ManualDock(TopDockPanel);
  67. end;
  68.  
  69. procedure TForm1.actToggleToolbarExecute(Sender: TObject);
  70. begin
  71.   ToolBar1.Visible := not (Sender as TAction).Checked
  72. end;
  73.  
  74. procedure TForm1.actToggleToolbarUpdate(Sender: TObject);
  75. begin
  76.   (Sender as TAction).Checked := ToolBar1.Visible
  77. end;
  78.  
  79. procedure TForm1.btnToggleFloatClick(Sender: TObject);
  80. begin
  81.   if ToolBar1.Floating then
  82.     ToolBar1.ManualDock(TopDockPanel)
  83.   else
  84.     //ToolBar1.ManualDock(nil)
  85.     ToolBar1.ManualFloat(
  86.       Rect(Left, Top, Left + ToolBar1.UndockWidth, Top + ToolBar1.UndockHeight))
  87. end;
  88.  
  89. procedure TForm1.DockPanelGetSiteInfo(Sender: TObject; DockClient: TControl;
  90.   var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
  91. begin
  92.   //Allow for more margin of error
  93.   InflateRect(InfluenceRect, 10, 10);
  94.   //Only accept toolbars
  95.   CanDock := DockClient is TToolBar
  96. end;
  97.  
  98. procedure TForm1.DockPanelDockOver(Sender: TObject;
  99.   Source: TDragDockObject; X, Y: Integer; State: TDragState;
  100.   var Accept: Boolean);
  101. var
  102.   DockBar: TToolBar;
  103.   InflateSize: Integer;
  104.   ARect: TRect;
  105.   ClientTL: TPoint;
  106. begin
  107.   DockBar := Source.Control as TToolBar;
  108.   //Get current height if horizontal or width if vertical
  109.   if DockBar.Width > DockBar.Height then
  110.     InflateSize := DockBar.Height
  111.   else
  112.     InflateSize := DockBar.Width;
  113.   //Dock rect will be 0 width/height as per the panel dimensions
  114.   //To make it look realistic, increase rectangle
  115.   //to same width/height as toolbar
  116.   ARect := Source.DockRect;
  117.   case (Sender as TPanel).Align of
  118.     alTop: Inc(ARect.Bottom, InflateSize);
  119.     alLeft: Inc(ARect.Left, InflateSize);
  120.     alBottom: Dec(ARect.Top, InflateSize);
  121.     alRight: Dec(ARect.Right, InflateSize);
  122.   end;
  123.   //Two of the four aligned dock panels will not stretch
  124.   //along edge of form client area (because of the currently
  125.   //visible one's size). Make sure dock rectangles do
  126.   ClientTL := Point(0, 0);
  127.   ClientTL := ClientToScreen(ClientTL);
  128.   case (Sender as TPanel).Align of
  129.     alTop, alBottom:
  130.     begin //Make horizontal panels stretch across form's client width
  131.       ARect.Left := ClientTL.X;
  132.       ARect.Right := ClientTL.X + ClientWidth;
  133.     end;
  134.     alLeft, alRight:
  135.     begin //Make vertical panels stretch across form's client width
  136.       ARect.Top := ClientTL.Y;
  137.       ARect.Bottom := ClientTL.Y + ClientHeight;
  138.     end;
  139.   end;
  140.   Source.DockRect := ARect
  141. end;
  142.  
  143. procedure TForm1.DockPanelDockDrop(Sender: TObject;
  144.   Source: TDragDockObject; X, Y: Integer);
  145. begin
  146.   //Get toolbar to reset its dimensions for docking
  147.   (Source.Control as TToolBar).Align := (Sender as TPanel).Align;
  148. end;
  149.  
  150. procedure TForm1.PageControl1DockDrop(Sender: TObject;
  151.   Source: TDragDockObject; X, Y: Integer);
  152. begin
  153.   if Source.Control = Image1 then
  154.     PageControl1.ActivePage.Caption := 'Athena'
  155. end;
  156.  
  157. procedure TForm1.PageControl1GetSiteInfo(Sender: TObject;
  158.   DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  159.   var CanDock: Boolean);
  160. begin
  161.   CanDock := not (DockClient is TToolBar)
  162. end;
  163.  
  164. end.
  165.